home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / t3_1 / risc_src.lha / risc_sources / comp / back_end / spemit.t < prev    next >
Encoding:
Text File  |  1990-04-12  |  7.3 KB  |  206 lines
  1. (herald spemit)
  2.  
  3. ;;; Copyright (c) 1985 Yale University
  4. ;;;     Authors: N Adams, R Kelsey, D Kranz, J Philbin, J Rees.
  5. ;;; This material was developed by the T Project at the Yale University Computer 
  6. ;;; Science Department.  Permission to copy this software, to redistribute it, 
  7. ;;; and to use it for any purpose is granted, subject to the following restric-
  8. ;;; tions and understandings.
  9. ;;; 1. Any copy made of this software must include this copyright notice in full.
  10. ;;; 2. Users of this software agree to make their best efforts (a) to return
  11. ;;;    to the T Project at Yale any improvements or extensions that they make,
  12. ;;;    so that these may be included in future releases; and (b) to inform
  13. ;;;    the T Project of noteworthy uses of this software.
  14. ;;; 3. All materials developed as a consequence of the use of this software
  15. ;;;    shall duly acknowledge such use, in accordance with the usual standards
  16. ;;;    of acknowledging credit in academic research.
  17. ;;; 4. Yale has made no warrantee or representation that the operation of
  18. ;;;    this software will be error-free, and Yale is under no obligation to
  19. ;;;    provide any services, by way of maintenance, update, or otherwise.
  20. ;;; 5. In conjunction with products arising from the use of this material,
  21. ;;;    there shall be no use of the name of the Yale University nor of any
  22. ;;;    adaptation thereof in any advertising, promotional, or sales literature
  23. ;;;    without prior written consent from Yale in each case.
  24. ;;;
  25.  
  26.               
  27. (define (generate-move ref1 ref2)
  28.   (if (neq? ref1 ref2)
  29.       (cond ((and (pair? ref1) (null? (cdr ref1)))
  30.          (generate-move-address (car ref1) ref2))
  31.         ((register? ref2)
  32.          (cond ((register? ref1)
  33.             (emit risc/add ref1 zero ref2))
  34.            ((and (pair? ref1)
  35.              (eq? (car ref1) 'lit))
  36.             (move-small-number (cdr ref1) ref2))
  37.            (else
  38.             (emit risc/load 'l ref1 ref2))))
  39.         ((register? ref1)
  40.          (emit risc/store 'l ref1 ref2))
  41.         (else
  42.          (if (and (pair? ref1) (eq? (car ref1) 'lit))
  43.          (move-small-number (cdr ref1) extra)
  44.          (emit risc/load 'l ref1 extra))
  45.          (emit risc/store 'l extra ref2)))))
  46.  
  47. (define (generate-move-addressable x mreg)
  48.   (if (eq? x 0) (generate-move zero mreg)
  49.   (let ((reg (if (register? mreg) mreg extra)))
  50.   (xcond ((eq? x '#t)
  51.       (emit risc/add (machine-true-value) zero reg))
  52.          ((eq? x '#f)
  53.       (emit risc/add nil-reg zero reg))
  54.          ((representable-fixnum? x 'move)
  55.       (move-small-number (fx* x 4) reg))
  56.      ((fixnum? x)
  57.      (emit sparc/sethi (unsigned-num
  58.              (fixnum-logand #x3fffff (fixnum-ashr x 8))) reg)
  59.      (emit risc/or
  60.            (unsigned-num (fixnum-logand #x3ff (fixnum-ashl x 2)))
  61.            reg reg))
  62.     ((char? x)
  63.      (let ((x (char->ascii x)))
  64.        (cond ((fx<= x #b1111)    ;12 bits unsigned, yikes!
  65.           (emit risc/or (unsigned-num (fx+ (fixnum-ashl x 8)
  66.                            header/char))
  67.                     zero reg))
  68.          (else
  69.           (emit sparc/sethi (unsigned-num
  70.                      (fixnum-bit-field x 2 6)) reg)
  71.           (emit risc/or (unsigned-num
  72.                  (fx+ (fixnum-ashl (fixnum-logand #b11 x) 8)
  73.                       header/char))
  74.             reg reg))))))
  75.   (generate-move reg mreg))))
  76.  
  77. (define (move-small-number x reg)
  78.   (emit risc/add (machine-num x) zero reg))
  79.  
  80. (define (emit-noop)
  81.   (emit sparc/noop))
  82.  
  83.                                      
  84. (define (generate-move-address from to)
  85.   (cond ((register? to)
  86.          (if (or (atom? from)
  87.                  (neq? (car from) to)
  88.                  (neq? (cdr from) 0))
  89.              (emit risc/add (machine-num (cdr from)) (car from) to)))
  90.         (else
  91.      (emit risc/add (machine-num (cdr from)) (car from) extra)
  92.          (emit risc/store 'l extra to))))
  93.  
  94. (define (need-stack-frame)
  95.   (modify (lambda-max-temps *lambda*)
  96.       (lambda (max-temp)
  97.         (max 1 max-temp))))
  98.  
  99. (define (emit-goto reg)
  100.   (need-stack-frame)
  101.   (emit-branch-and-link 8)        ;one past delay
  102.   (emit risc/add (machine-num template-return-offset) link-reg link-reg)
  103.   (emit risc/sll (machine-num 1) reg scratch)
  104.   (emit sparc/jmpl (list 'reg-reg link-reg scratch) zero)
  105.   (emit-noop))
  106.  
  107. (define (generate-move-pcrel from to)
  108.   (need-stack-frame)
  109.   (emit-branch-and-link 8) ;one past delay
  110.   (let ((thing (tp-offset from)))    ;this really stinks
  111.     (cond ((register? to)
  112.        (emit sparc/sethi thing to)
  113.        (emit risc/or thing to to)
  114.        (emit risc/add to link-reg to))
  115.     (else
  116.      (emit sparc/sethi thing extra)
  117.      (emit risc/or thing extra extra)
  118.      (emit risc/add extra link-reg extra)
  119.      (emit risc/store 'l extra to)))))
  120.                
  121. (define-integrable (generate-slink-call offset)
  122.   (need-stack-frame)
  123.   (emit risc/load 'l (reg-offset nil-reg offset) extra)
  124.   (emit sparc/jmpl (reg-offset extra 0) link-reg)
  125.   (emit risc/add (machine-num template-return-offset) link-reg link-reg) ;3 template + current/delay
  126.   (emit-bogus-stack-template))
  127.  
  128. (define-integrable (generate-slink-jump offset)
  129.   (emit risc/load 'l (reg-offset nil-reg offset) extra)
  130.   (emit sparc/jmpl (reg-offset extra 0) zero))
  131.  
  132. (define-integrable (generate-jump label)
  133.   (emit-jump label))
  134.  
  135. (define-integrable (generate-avoid-jump label)
  136.   (emit-avoid-jump label))
  137.  
  138. (define-integrable (generate-save-jump-and-link l)
  139.   (emit-branch-and-link l)
  140.   (emit risc/add (machine-num template-return-offset) link-reg link-reg)) ;skip template
  141.  
  142. (define-integrable (generate-save-avoid-jump-and-link l)
  143.   (emit-branch-and-link l)
  144.   (emit risc/add (machine-num template-return-offset) link-reg link-reg)) ;skip template
  145.  
  146.  
  147. (define (generate-general-call-and-link proc-var n-args)
  148.   (cond ((and (or (variable-binder proc-var)
  149.           (var-is-vcell? proc-var)))
  150.      (generate-move (machine-num (fx+ n-args 1)) NARGS)
  151.      (emit risc/load 'l (reg-offset nil-reg slink/icall) extra)
  152.      (emit sparc/jmpl (reg-offset extra 0) link-reg))
  153.     (else
  154.          (generate-move (machine-num (fx+ n-args 1)) NARGS)
  155.      (emit risc/load 'l (reg-offset P (fx- tag/extend CELL)) extra)
  156.          (emit sparc/jmpl (reg-offset extra 2) link-reg)))
  157.   (emit risc/add (machine-num template-return-offset) link-reg link-reg)) ;skip template
  158.     
  159.  
  160. (define (generate-general-call proc-var n-args)
  161.   (cond ((and (or (variable-binder proc-var)
  162.           (var-is-vcell? proc-var)))
  163.      (emit risc/load 'l (reg-offset nil-reg slink/icall) extra)
  164.      (emit sparc/jmpl (reg-offset extra 0) zero)
  165.      (generate-move (machine-num (fx+ n-args 1)) NARGS))
  166.     (else
  167.          (emit risc/load 'l (reg-offset P (fx- tag/extend CELL)) extra)
  168.      (emit sparc/jmpl (reg-offset extra 2) zero)
  169.          (generate-move (machine-num (fx+ n-args 1)) NARGS))))
  170.  
  171.  
  172. (define (generate-return n-args)               
  173.   (emit sparc/jmpl (reg-offset link-reg 0) zero)
  174.   (generate-move (machine-num (fx- -1 n-args)) NARGS))
  175.  
  176. (define (emit op . args)
  177.   (asemit op (map! ->field-group args)))
  178.  
  179. (define (->field-group operand)
  180.   (xcond ((fixnum? operand)
  181.       (register->field-group operand))
  182.          ((atom? operand) operand)
  183.          ((fixnum? (car operand))
  184.       (list 'reg-offset (symbolic->machine-reg (car operand)) (cdr operand)))
  185.      ((eq? (car operand) 'reg-reg)
  186.       (list 'reg-reg 
  187.         (symbolic->machine-reg (cadr operand))
  188.         (symbolic->machine-reg (caddr operand))))
  189.      ((atom? (car operand)) operand)))
  190.  
  191.  
  192. (define (symbolic->machine-reg reg) reg)
  193.  
  194. (define (register->field-group reg)
  195.   (cond ((fx< reg *real-registers*) (symbolic->machine-reg reg))
  196.     (else
  197.      (list 'reg-offset SP (fx* CELL (fx- reg *real-registers*))))))
  198. #|
  199. (define (register->field-group reg)
  200.   (cond ((fx< reg *real-registers*) (symbolic->machine-reg reg))
  201.     (else
  202.      (list 'reg-offset SP (fx* CELL (fx+ (fx- reg *real-registers*) 64))))))
  203. |#
  204.  
  205.  
  206.